home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / handson / archive / Issue147 / Delphi files / lpunit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-09-25  |  9.6 KB  |  303 lines
  1. unit Lpunit;
  2. {
  3.   PC Plus sample Delphi application.
  4.  
  5.   A simple drag-and-drop-enabled application 'launch pad'.
  6.   * This version can load document files with the icon of their
  7.   associated applications (e.g. if Word is installed, a .DOC file will
  8.   display the Word icon.
  9.   * A menu has been added.
  10.   * It lets you save and load your icon bar.
  11.   * It loads a previously saved icon bar automically when it is run.
  12.   * A menu option lets you clear the buttons from the bar.
  13.   * A horizontal scroll bar appears when buttons extend beyond the form edge.
  14.   * Various error messages are displayed when files can't be loaded or run.
  15.  
  16.   Usage: Select 1 or more files in the Windows Explorer and drag/drop
  17.   them onto the launch pad. Those that contain an icon will be shown as
  18.   an iconic button, those without an icon will be shown as a plain labelled
  19.   button. Once installed, a button can be clicked to launch the
  20.   associated application.
  21.  
  22.   The main additions to this version are indicated by comments starting
  23.   with the characters:
  24.        {!!
  25.  
  26.   Limitations: Could do with more error checking/recovery.
  27.  
  28.   Compatibility: Delphi 2.0 and above
  29.  
  30.   Author: Huw Collingbourne
  31. }
  32.  
  33. interface
  34.  
  35. uses
  36.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  37.   Forms, Dialogs,
  38.   ShellAPI, StdCtrls, Buttons, ExtCtrls, Menus; {!! must use the ShellAPI unit }
  39.                                          {!! BitBtn needs the Buttons unit     }
  40.  
  41. type
  42.   TForm1 = class(TForm)
  43.     MainMenu1: TMainMenu;
  44.     FileMenu: TMenuItem;
  45.     SaveMenuItem: TMenuItem;
  46.     ReloadMenuItem: TMenuItem;
  47.     ClearAllMenuItem: TMenuItem;
  48.     N1: TMenuItem;
  49.     ExitMenuItem: TMenuItem;
  50.     procedure FormCreate(Sender: TObject);
  51.     procedure SaveMenuItemClick(Sender: TObject);
  52.     procedure ReloadMenuItemClick(Sender: TObject);
  53.     procedure ClearAllMenuItemClick(Sender: TObject);
  54.     procedure ExitMenuItemClick(Sender: TObject);
  55.     procedure FormShow(Sender: TObject);
  56.   private
  57.     { Private declarations }
  58.     ButtonList : TStringList;    {!! This StringList holds our BitBtns      }
  59.     procedure RespondToMessage(var Msg: Tmsg; var Handled: Boolean);
  60.     procedure BtnClick(Sender: TObject);
  61.     procedure AddBtn( fname : string );
  62.     procedure ClearAll;
  63.     procedure AddErrorMsg( msg : string );
  64.     procedure ReloadButtons;
  65.     procedure DealWithScrollBar;
  66.     procedure CheckForErrors;
  67.   public
  68.     { Public declarations }
  69.   end;
  70.  
  71. const
  72.   { define various useful constants }
  73.   BUFFLEN = 255;
  74.   BUTTONWIDTH = 100;
  75.   FORMHEIGHT = 100;             { height of form without a scrollbar visible }
  76.   SCROLLFORMHEIGHT = 125;       { height of form with a scrollbar visible    }
  77.   CONFIGFILE = 'Iconbar.sav';   { name of file to save/load buttonbar config }
  78.  
  79. type
  80.   CHARARRAY = array[0..BUFFLEN] of char;
  81. var
  82.   Form1: TForm1;
  83.   Icon : TIcon; {!! An icon to put onto a button }
  84.  
  85. implementation
  86.  
  87. uses errordlgunit;
  88. {$R *.DFM}
  89.  
  90. function ExecuteFile(const FileName, Dir : string ) : THandle;
  91. {!! A simple interface to the API's ShellExecute function that opens
  92.     the application specified by FileName }
  93. var
  94.   ntFileName, ntDir : CHARARRAY;
  95. begin
  96.   Result := ShellExecute(Application.MainForm.Handle,
  97.   nil,      { nil here equates to the default command,'Open' }
  98.   StrPCopy(ntFileName, FileName),
  99.   nil,
  100.   StrPCopy(ntDir,Dir),
  101.   SW_SHOW);
  102. end;
  103.  
  104. procedure TForm1.DealWithScrollBar;
  105. {!! If there are more buttons than fit onto the form, add a scrollbar
  106.   and expand the height of the form to make room for it.
  107.   Note Scrollbar.Range must be greater than the Client width of the
  108.   form for the Scrollbar to appear }
  109. var
  110.    bw : integer;
  111. begin
  112.    bw := ButtonList.Count * BUTTONWIDTH;
  113.    if bw > Form1.ClientWidth then
  114.       Form1.Height :=  SCROLLFORMHEIGHT
  115.    else
  116.        Form1.Height := FORMHEIGHT;
  117.    HorzScrollBar.Range := bw;
  118. end;
  119.  
  120. procedure TForm1.ClearAll;
  121. {!! Clear buttons from Form and from ButtonList }
  122. var
  123.    i : integer;
  124. begin
  125.    // Remove the buttons from the form
  126.     for i := 0 to (ButtonList.Count-1) do
  127.        TBitBtn(ButtonList.Objects[i]).Parent := nil;
  128.    // Clear the ButtonList
  129.    ButtonList.Clear;
  130. end;
  131.  
  132. procedure TForm1.AddErrorMsg( msg : string );
  133. {!! Add error message, msg, to the Memo on the ErrorDlg form }
  134. begin
  135.    ErrorDlg.ErrMemo.Lines.Add( msg );
  136. end;
  137.  
  138. procedure TForm1.CheckForErrors;
  139. {!! If there is any text in the Memo on the ErrorDlg form
  140.   these are error messages so show the ErrorDlg form }
  141. begin
  142.     if ErrorDlg.ErrMemo.Text <> '' then
  143.        ErrorDlg.ShowModal;
  144.     ErrorDlg.ErrMemo.Clear;
  145. end;
  146.  
  147.  
  148. procedure TForm1.AddBtn( fname : string );
  149. { Create a new application launching button, complete with glyph
  150.   and label. Add it to the Form }
  151. var
  152.   lplicon  : word;         {!! required argument to ExtractAssociatedIcon }
  153.   buffer   : CHARARRAY;    { PChar version of the filename fname          }
  154. begin
  155.   lplicon := 0;
  156.   StrPCopy(buffer,fname);
  157.   if not FileExists(fname) then
  158.      AddErrorMsg('Load error: Can''t locate ' + fname )
  159.   else
  160.   begin  { if FileExists }
  161.              {!! get icon for EXE file or of application associated with file }
  162.      Icon.Handle := ExtractAssociatedIcon(HInstance, buffer, lplicon);
  163.      ButtonList.AddObject(fname, TBitBtn.Create(Self));
  164.      with TBitBtn(ButtonList.Objects[ButtonList.Count-1]) do
  165.      begin
  166.         with Glyph do
  167.         begin
  168.           width := 32;
  169.           height := 32;
  170.           if Icon.Handle <> 0 then
  171.              Canvas.Draw(0,0,Icon);
  172.         end;
  173.               { set the size, font etc. of the BitBtn itself  }
  174.         width := BUTTONWIDTH;
  175.         layout := blGlyphTop;
  176.         font.name := 'Arial';
  177.         font.size := 8;
  178.         caption := ExtractFileName(fname);
  179.         Align := alLeft;
  180.         Parent := Form1;          { put the BitBtn onto the form       }
  181.         OnClick := BtnClick;      { set BitBtn's OnClick event-handler }
  182.      end;  { with TBitBtn }
  183.   end;  { if FileExists }
  184. end;
  185.  
  186. procedure TForm1.RespondToMessage(var Msg: Tmsg; var Handled: Boolean);
  187. { Iterate through all file names if a multi-file selection was dropped }
  188. const
  189.   FileIndex : Cardinal = Cardinal(-1);   { return a count of dropped files }
  190. var                                      { $FFFF 16-bit;  $FFFFFFFF 32-bit }
  191.   buffer : CHARARRAY;
  192.   fname : string;
  193.   fnum  : word;
  194. begin
  195.    if Msg.Message = WM_DROPFILES then
  196.    begin
  197.       for fnum := 0 to DragQueryFile(Msg.WParam, FileIndex, NIL, BUFFLEN)-1 do
  198.       begin
  199.          DragQueryFile(Msg.WParam, fnum, buffer, BUFFLEN);
  200.          fname  := StrPas(buffer);
  201.          AddBtn(fname);
  202.       end;
  203.     DragFinish(Msg.WParam);
  204.     Handled := True;
  205.     CheckForErrors;
  206.     DealWithScrollBar;
  207.    end;
  208. end;
  209.  
  210. procedure TForm1.FormCreate(Sender: TObject);
  211. begin
  212.     { make this form drag-friendly }
  213.   DragAcceptFiles(Form1.Handle, true);
  214.   Application.OnMessage := RespondToMessage;
  215.   ButtonList := TStringList.Create; { Create StringList to store our BitBtns }
  216. end;
  217.  
  218. procedure TForm1.BtnClick(Sender: TObject);
  219. {   The BitBtns' OnClick event-handler                                         }
  220. {   The Sender parameter indicates which button on the form was clicked.
  221.     We locate the position of the button in our ButtonList.
  222.     ButtonList is a StringList containing a String (the executable file's path)
  223.     alongside each button. We are able to use pass this string (and also to
  224.     parse out the directory part of the string) to a function that launches the
  225.     application.
  226. }
  227. var
  228.    filename, errmsg : string;
  229.    retval   : word;
  230. begin
  231.   errmsg := 'Couldn''t run ' + filename;
  232.   filename := ButtonList.Strings[ButtonList.IndexOfObject(Sender)];
  233.      retval := ExecuteFile(filename, ExtractFilePath(filename));
  234.      if retval <= 32 then {!! i.e. if it's an error }
  235.      begin
  236.        case (retval) of   {!! check retval against ShellAPI constants }
  237.          ERROR_FILE_NOT_FOUND : errmsg := filename + ' not found!';
  238.          ERROR_PATH_NOT_FOUND : errmsg := 'Path to ' + filename + 'not found!';
  239.          SE_ERR_NOASSOC          : errmsg := 'There is no application associated'
  240.                                           + ' with ' + filename + '!';
  241.         end;
  242.           ShowMessage('ERROR!: ' + errmsg);
  243.      end;
  244. end;
  245.  
  246. procedure TForm1.ReloadButtons;
  247. {!! Reloads the Buttonbar from CONFIGFILE.
  248.   NOTE: No check is made that CONFIGFILE exists.
  249.   It is up to the calling procedure to cgeck this. }
  250. var
  251.    templist : TStringList;
  252.    i        : integer;
  253. begin
  254.    //{!! Remove the buttons
  255.    ClearAll;
  256.    //{!! Then rebuild the Panel and List from saved file names
  257.    templist  := TStringList.Create;
  258.    templist.LoadFromFile(CONFIGFILE);
  259.    for i := 0 to (templist.count-1) do
  260.        AddBtn(templist.Strings[i]);
  261.    templist.Free;
  262.    CheckForErrors;
  263.    DealWithScrollBar;
  264. end;
  265.  
  266. procedure TForm1.SaveMenuItemClick(Sender: TObject);
  267. begin
  268.   ButtonList.SaveToFile(CONFIGFILE);
  269. end;
  270.  
  271.  
  272. procedure TForm1.ReloadMenuItemClick(Sender: TObject);
  273. begin
  274.    if not FileExists(CONFIGFILE) then
  275.       ShowMessage('Can''t load buttons. Config file '
  276.                           + CONFIGFILE + ' not found!' )
  277.    else
  278.        ReloadButtons;
  279. end;
  280.  
  281. procedure TForm1.ClearAllMenuItemClick(Sender: TObject);
  282. begin
  283.   ClearAll;
  284.   DealWithScrollBar;
  285. end;
  286.  
  287. procedure TForm1.ExitMenuItemClick(Sender: TObject);
  288. begin
  289.   Close;
  290. end;
  291.  
  292. procedure TForm1.FormShow(Sender: TObject);
  293. begin
  294.   {!! Load Saved Buttons if a CONFIGFILE exists }
  295.   if not FileExists(CONFIGFILE) then
  296.       ShowMessage('Config file '
  297.           + CONFIGFILE + ' not found! Loading an empty AppLauncher bar' )
  298.    else
  299.        ReloadButtons;
  300. end;
  301.  
  302. end.
  303.